home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0093_Vesa Unit 2!.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  10KB  |  382 lines
  1. {
  2. Here's some VESA routines. The drawing stuff is quite limited right now
  3. (to pixels and horizontal lines in 256-color linear modes only) but it
  4. detects/sets/describes most everything else. Also no save/restore video
  5. state yet. It uses direct VESA function calls instead of interrupts, and
  6. tries to optimize where it puts the window based on what the routines
  7. will be used for . . .
  8. }
  9.  
  10. {VESA1.PAS}
  11. {by Sean Palmer}
  12. {with help from Ferraro and Olaf Bartlett}
  13.  
  14. type
  15.   pModeList = ^tModeList;
  16.   tModeList = Array [0..255] of word; {list of modes terminated by -1}
  17.                                       {VESA modes are >=100h}
  18.  
  19.   modeAttrBits = (modeAvail,
  20.                   modeExtendInfo,
  21.                   modeBIOSsupport,
  22.                   modeColor,
  23.                   modeGraphics,
  24.                   modeBit5,
  25.                   modeBit6,
  26.                   modeBit7,
  27.                   modeBit8);
  28.  
  29.   winAttrBits  = (winSupported,
  30.                   winReadable,
  31.                   winWriteable);
  32.  
  33.   tMemModel    = (modelText,
  34.                   modelCGA,
  35.                   modelHerc,
  36.                   model4Plane,
  37.                   modelPacked,
  38.                   modelModeX,
  39.                   modelRGB);
  40.  
  41.  
  42. var
  43.   VESAinfo : record
  44.     signature : array [1..4] of char;
  45.     version   : word;
  46.     str       : pChar;
  47.     caps      : longint;
  48.     modeList  : pModeList;
  49.     pad       : array [18..255] of byte;
  50.   end;
  51.  
  52.   modeInfo : record
  53.     attr           : set of modeAttrBits;
  54.     winAAttr,
  55.     winBAttr       : set of winAttrBits;
  56.     winGranularity : word;  {in K}
  57.     winSize        : word;         {in K}
  58.     winASeg,
  59.     winBSeg        : word; {segment to access window with}
  60.     winFunct       : procedure;
  61.     scanBytes      : word;       {bytes per scan line}
  62.     extendedInfo   : record
  63.       xRes, yRes : word;    {pixels}
  64.       xCharSize,
  65.       yCharSize  : byte;
  66.       planes     : byte;
  67.       bitsPixel  : byte;
  68.       banks      : byte;
  69.       memModel   : tMemModel;
  70.       bankSize   : byte;  {in K}
  71.     end;
  72.  
  73.     pad : array [29..255] of byte;
  74.   end;
  75.  
  76.   xSize,
  77.   ySize,
  78.   xBytes     : word;
  79.   bits       : byte;
  80.   model      : tMemModel;
  81.   window     : byte;
  82.   winSeg     : word;
  83.   granShifts : byte;
  84.   winLo,
  85.   winHi,
  86.   winBytes,
  87.   granMask   : longint;
  88.   funct      : procedure;
  89.  
  90.   m, i : word;
  91.  
  92.  
  93.  
  94. function getVESAInfo : boolean; assembler;
  95. asm
  96.   mov ax,4F00h
  97.   push ds
  98.   pop es
  99.   mov di,offset VESAinfo
  100.   int 10h
  101.   sub ax,004Fh  {make sure we got 004Fh back}
  102.   cmp ax,1
  103.   sbb al,al
  104.   cmp word ptr es:[di],'V'or('E'shl 8)  {signature should be 'VESA'}
  105.   jne @@ERR
  106.   cmp word ptr es:[di+2],'S'or('A'shl 8)
  107.   je @@X
  108.  @@ERR:
  109.   mov al,0
  110.  @@X:
  111. end;
  112.  
  113.  
  114. function getModeInfo(mode:word):boolean;assembler;asm
  115.  mov ax,4F01h
  116.  mov cx,mode
  117.  push ds
  118.  pop es
  119.  mov di,offset modeInfo
  120.  int 10h
  121.  sub ax,004Fh   {make sure it's 004Fh}
  122.  cmp ax,1
  123.  sbb al,al
  124.  end;
  125.  
  126.  
  127. {if the VESA driver supports info on the regular VGA modes, add them to list}
  128. procedure includeStandardVGAModes;var p:^word;begin
  129.  p:=pointer(VESAInfo.modeList);
  130.  while p^<>$FFFF do inc(p);
  131.  if getModeInfo($10) then begin p^:=$10; inc(p);end;
  132.  if getModeInfo($12) then begin p^:=$12; inc(p);end;
  133.  if getModeInfo($13) then begin p^:=$13; inc(p);end;
  134.  p^:=$FFFF;
  135.  end;
  136.  
  137.  
  138. function setMode(mode:word):boolean;var i:word;begin
  139.  if getModeInfo(mode) then begin
  140.   with modeInfo do begin
  141.    if winSupported in winAAttr then begin window:=0; winSeg:=winASeg;end
  142.    else if winSupported in winBAttr then begin window:=1; winSeg:=winBSeg;end
  143.    else exit;  {you call this a VESA mode?}
  144.    with extendedInfo do begin
  145.     xSize:=xRes; ySize:=yRes; xBytes:=scanBytes; bits:=bitsPixel;
  146.     model:=memModel;
  147.     end;
  148.    winBytes:=longint(winSize)*1024;  {wraps to 0 if 64k}
  149.    winLo:=0; winHi:=winBytes;
  150.    i:=winGranularity;
  151.    granShifts:=10; {for 1K}
  152.    while not odd(i) do begin
  153.     i:=i shr 1;
  154.     inc(granShifts);
  155.     end;
  156.    if i<>1 then begin setMode:=false;exit;end;  {granularity not power of 2}
  157.    granMask:=(longint(1)shl granShifts)-1;
  158.    funct:=winFunct;
  159.    end;
  160.   asm
  161.    mov ax,4F02h
  162.    mov bx,mode
  163.    int 10h
  164.    sub ax,004Fh
  165.    cmp ax,1
  166.    sbb al,al
  167.    mov @RESULT,al
  168.    end;
  169.   end;
  170.  end;
  171.  
  172. function getMode:word;assembler;asm  {return -1 if error}
  173.  mov ax,4F03h
  174.  int 10h
  175.  cmp ax,004Fh
  176.  je @@OK
  177.  mov ax,-1
  178.  jmp @@X
  179. @@OK: mov ax,bx
  180. @@X:
  181.  end;
  182.  
  183.  
  184. procedure plot(x, y : word; c : byte);
  185. var
  186.   bank : word;
  187.   offs : longint;
  188. begin
  189.   offs := longint(y) * xBytes + x;
  190.   if (offs < winLo) or (offs >= winHi) then
  191.   begin
  192.     winLo := (offs - (winBytes shr 1)) and not granMask;
  193.     winHi := winLo + winBytes;
  194.     bank  := winLo shr granShifts;
  195.     asm
  196.       mov bl, window
  197.       mov dx, bank
  198.       call [funct]
  199.     end;
  200.   end;
  201.   mem[winSeg : word(offs) - word(winLo)] := c;
  202. end;
  203.  
  204. procedure hLin(x,x2,y:word;c:byte);
  205. var bank,w:word; offs:longint;
  206. begin
  207.   w:=x2-x;
  208.   offs:=longint(y)*xBytes+x;
  209.   if (offs<winLo)or(offs+w>=winHi) then begin
  210.    winLo:=offs and not granMask;
  211.    winHi:=winLo+winBytes;
  212.    bank:=winLo shr granShifts;
  213.    asm
  214.     mov bl,window
  215.     mov dx,bank
  216.     call [funct]
  217.     end;
  218.    end;
  219.   fillChar(mem[winSeg:word(offs)-word(winLo)],w,c);
  220.   end;
  221.  
  222. function scrn(x,y:word):byte;
  223. var bank:word; offs:longint;
  224. begin
  225.   offs:=longint(y)*xBytes+x;
  226.   if (offs<winLo)or(offs>=winHi) then begin
  227.    winLo:=(offs-(winBytes shr 1))and not granMask;
  228.    winHi:=winLo+winBytes;
  229. bank:=winLo shr granShifts;
  230.    asm
  231.     mov bl,window
  232.     mov dx,bank
  233.     call [funct]
  234.     end;
  235.    end;
  236.   scrn:=mem[winSeg:word(offs)-word(winLo)];
  237.   end;
  238.  
  239. {will find a color graphics mode that matches parms}
  240. {if parm is 0, finds best mode for that parm}
  241. function findMode(x,y:word;model:tMemModel;nBits,nPlanes,nBanks:byte):word;
  242. var p:^word; m:word; gx,gy,gb,lp,lb:word;
  243. begin
  244.  gx:=0;gy:=0;gb:=0;lp:=255;lb:=255;
  245.  p:=pointer(VESAInfo.modeList);
  246.  m:=$FFFF;
  247.  while p^<>$FFFF do begin
  248.   if getModeInfo(p^) then
  249.    with modeInfo do
  250.     if attr+[modeAvail,modeExtendInfo,modeColor,modeGraphics]=attr then
  251.      with extendedInfo do
  252. if ((xRes=x)or((x=0)and(gx<=xRes)))
  253.       and((yRes=y)or((y=0)and(gy<=yRes)))
  254.       and(memModel=model)
  255.       and((bitsPixel=nBits)or((nBits=0)and(gb<=bitsPixel)))
  256.       and((planes=nPlanes)or((nPlanes=0)and(lp>=planes)))
  257.       and((banks=nBanks)or((nBanks=0)and(lb>=banks)))
  258.       then begin
  259.        gx:=xRes;gy:=yRes;gb:=bitsPixel;lp:=planes;lb:=banks;
  260.        m:=p^;
  261.        end;
  262.   inc(p);
  263.   end;
  264.  if m<>$FFFF then getModeInfo(m);
  265.  findMode:=m;  {0FFFFh if not found. Try a standard mode number then.}
  266.  end;
  267.  
  268.  
  269. procedure displayVESAInfo;
  270.  
  271. type
  272.   string2=string[2];
  273.   string4=string[4];
  274.   string8=string[8];
  275. const
  276.   modelStr : array[tMemModel]of pChar=
  277.     ('Text','CGA','Hercules','EGA','Linear','mode X','RGB');
  278. var
  279.   p:^word;
  280.  
  281.   function hexB(n:byte):string2; assembler;asm
  282.    les di,@RESULT;                    {adr of function result}
  283.   cld; mov al,2; stosb;              {set len}
  284.    mov al,n; mov ah,al;               {save it}
  285.    shr al,1; shr al,1; shr al,1; shr al,1; {high nibble}
  286.    add al,$90; daa; adc al,$40; daa;  {convert hex nibble to ASCII}
  287.    stosb;
  288.    mov al,ah; and al,$F;              {low nibble}
  289.    add al,$90; daa; adc al,$40; daa;
  290.    stosb;
  291.    end;
  292.  
  293.   function hexW(n:word):string4;
  294.   begin
  295.     hexW:=hexB(hi(n))+hexB(lo(n));
  296.   end;
  297.  
  298.   function hexL(n:longint):string8;
  299.   begin
  300.     hexL:=hexW(n shr 16)+hexW(n);
  301.   end;
  302.  
  303. begin
  304.  if getVESAInfo then
  305.   with VESAinfo do begin
  306.    includeStandardVGAModes;
  307.    writeln(signature,' Version ',hexB(hi(version)),'.',hexB(version));
  308.    writeln(str);
  309.    writeln('Capabilities: $',hexL(caps));
  310.    p:=pointer(modeList);
  311. while p^<>$FFFF do begin
  312.     write('Mode $',hexW(p^),' = ');
  313.     if getModeInfo(p^) then
  314.      with modeInfo do begin
  315.       if not(modeAvail in attr) then write('Unavailable-');
  316.       if modeColor in attr then write('Color ') else write('Mono ');
  317.       if modeGraphics in attr then write('Graphics') else write('Text');
  318.       if modeBIOSSupport in attr then write('-BIOSsupport');
  319.       writeln;
  320.       if modeExtendInfo in attr then
  321.        with extendedInfo do begin
  322.         write('  ',xRes,'x',yRes,', ',bitsPixel,' bits, ',modelStr[memModel],
  323.                 ', ',scanBytes,' bytes per row');
  324.         if not (modeGraphics in attr) then
  325.          write(^M^J'  Character size ',xCharSize,'x',yCharSize);
  326.         if planes>1 then write(', ',planes,' planes');
  327.         if banks>1 then write(', ',banks,' banks of ',bankSize,'K');
  328.         writeln;
  329.         end
  330.       else write('  No extended info available');
  331.       if winSupported in winAAttr then begin
  332.        write('  Window A: ');
  333.        if winReadable in winAAttr then write('R');
  334. if winWriteable in winAAttr then write('W');
  335.        writeln(' at segment $',hexW(winASeg),', ',winSize,'K, granular by '
  336.                ,winGranularity,'K, function at $',hexL(longint(@winFunct)));
  337.        end;
  338.       if winSupported in winBAttr then begin
  339.        write('  Window B: ');
  340.        if winReadable in winBAttr then write('R');
  341.        if winWriteable in winBAttr then write('W');
  342.        writeln(' at segment $',hexW(winBSeg),', ',winSize,'K, granular by '
  343.                ,winGranularity,'K, function at $',hexL(longint(@winFunct)));
  344.        end;
  345.       end
  346.     else writeln('ERROR');
  347.     inc(p);
  348.     end;
  349.    end
  350.  else writeln('No VESA driver found');
  351.  end;
  352.  
  353. begin
  354.   writeln;
  355.   displayVESAInfo;
  356.   readln;
  357.   m := findMode(0, 0, modelPacked, 8, 1, 1);
  358.   getModeInfo(m);
  359.   if m <> $FFFF then
  360.   with modeInfo.extendedInfo do
  361.     writeln('Found ', xRes, 'x', yRes, 'x',
  362.             longint(1) shl bitsPixel, ' mode ', m)
  363.   else
  364.     exit;
  365.  
  366.   setMode(m);
  367.   for i := 1 to 10000 do
  368.     plot(random(xSize), random(ySize), random(256));
  369.  
  370.   readln;
  371.  
  372.   for i := 1 to 200 do
  373.     hlin(random(xSize shr 1), random(xSize shr 1) + xSize shr 1,
  374.                 random(ySize), random(256));
  375.   readln;
  376.  
  377.   asm
  378.     mov ax, 3h
  379.     int 10h
  380.   end;
  381. end.
  382.